home *** CD-ROM | disk | FTP | other *** search
Text File | 1990-09-21 | 40.0 KB | 1,838 lines | [TEXT/MPS ] |
- *******************************************************
- * *
- * DYNAMO *
- * *
- * Apple II 8-bit runtime macros. *
- * Copyright (C) 1990 Apple Computer. *
- * Version 4.1 *
- * *
- * Written by Eric Soldan, Apple II DTS *
- * *
- *******************************************************
-
- * These macros are interfaces for the runtime routines associated with them.
- * The runtime routines handle up to 128 integer variables, and up to 256
- * strings. The integer functions are simple add,sub,mul,div, and others.
- * These others include mass-initialization, min, max, print decimal, etc.
- * The string functions are most of what is available in AppleSoft, in
- * various forms. There is also support for multi-dimension arrays.
-
- * The principle of the runtime routines is that the xreg holds a destination
- * variable number (for ints: 0-254, for strings: 0-255). All runtimes preserve
- * the xreg, therefore, you can do multiple operations to a single variable
- * without having to reload the xreg. The values that are used on the xreg
- * variable (the source data), is one of 3 forms for integers:
- * 1. 1-byte value
- * 2. 2-byte value
- * 3. 2-byte integer variable.
- * 1-byte values are placed in the acc. 2-byte values are placed in the acc,y
- * (acc=lo, y=hi). 2-byte integer variables have the variable number placed in
- * the yreg. (The yreg is not preserved by the runtime routines.)
- * Once the source data is loaded (in acc, acc-y, or y), the proper call to the
- * runtime routines is made. The 'proper' routine is based on the type of data
- * the source is. (If the source is a variable, and we are adding, the macro
- * will call the addvar routine.)
-
- * Strings are also referenced by number. There are 3 tables for strings:
- * 1. String length table.
- * 2. Max string length table.
- * 3. Pointer table.
- * So, each string takes up four bytes, plus however long the max string length
- * is. Having the pointer allows the program to point into memory that was
- * never loaded or initialized. This can save time loading the application from
- * disk. The string routines will never overwrite the buffer space alloced for
- * them. The string will be truncated. So, you can append strings without
- * worry about clobbering memory.
-
-
- *****************************************************************
- *****************************************************************
- *****************************************************************
-
- * These macros are called by other macros in this file.
-
- ***************************************
-
- MACRO
- acorm &op
- lclc &str
- &str setc &op
- if &substr(&str,1,1)='#' goto .imm
- if &substr(&str,1,1)<>'*' then
- aerror 'non-variable parameter must start with a # or *'
- mexit
- endif
- &str setc &substr(&str,2,999)
- lcla &deref
- &deref seta 0
- .a if &substr(&str,1,1)<>'*' goto .b
- &str setc &substr(&str,2,999)
- &deref seta &deref+1
- goto .a
- .b if &substr(&str,1,1)='<' then
- &str setc &substr(&str,2,999)
- endif
- if &deref>0 then
- lda &str+1
- sta aderefz+2
- endif
- lda &str
- .d if &deref>0 then
- jsr aderef
- &deref seta &deref-1
- goto .d
- endif
- mexit
- .imm
- &str setc &substr(&str,2,999)
- if &substr(&str,1,1)='<' then
- &str setc &substr(&str,2,999)
- endif
- lda #<&str
- MEND
-
- ***************************************
-
- MACRO
- xcorm &op
- lclc &str
- &str setc &op
- if &substr(&str,1,1)='#' goto .imm
- if &substr(&str,1,1)<>'*' then
- aerror 'non-variable parameter must start with a # or *'
- mexit
- endif
- &str setc &substr(&str,2,999)
- lcla &deref
- &deref seta 0
- .a if &substr(&str,1,1)<>'*' goto .b
- &str setc &substr(&str,2,999)
- &deref seta &deref+1
- goto .a
- .b if &substr(&str,1,1)='<' then
- &str setc &substr(&str,2,999)
- endif
- if &deref>0 then
- ldx &str+1
- stx xderefz+2
- endif
- ldx &str
- .d if &deref>0 then
- jsr xderef
- &deref seta &deref-1
- goto .d
- endif
- mexit
- .imm
- &str setc &substr(&str,2,999)
- if &substr(&str,1,1)='<' then
- &str setc &substr(&str,2,999)
- endif
- ldx #<&str
- MEND
-
- ***************************************
-
- MACRO
- ycorm &op
- lclc &str
- &str setc &op
- if &substr(&str,1,1)='#' goto .imm
- if &substr(&str,1,1)<>'*' then
- aerror 'non-variable parameter must start with a # or *'
- mexit
- endif
- &str setc &substr(&str,2,999)
- lcla &deref
- &deref seta 0
- .a if &substr(&str,1,1)<>'*' goto .b
- &str setc &substr(&str,2,999)
- &deref seta &deref+1
- goto .a
- .b if &substr(&str,1,1)='<' then
- &str setc &substr(&str,2,999)
- endif
- if &deref>0 then
- ldy &str+1
- sty yderefz+2
- endif
- ldy &str
- .d if &deref>0 then
- jsr yderef
- &deref seta &deref-1
- goto .d
- endif
- mexit
- .imm
- &str setc &substr(&str,2,999)
- if &substr(&str,1,1)='<' then
- &str setc &substr(&str,2,999)
- endif
- ldy #<&str
- MEND
-
- ***************************************
-
- MACRO
- axcorm &op
- axisbyte set 0
- lclc &str
- &str setc &op
- if &substr(&str,1,1)='#' goto .imm
- if &substr(&str,1,1)<>'*' then
- aerror 'non-variable parameter must start with a # or *'
- mexit
- endif
- &str setc &substr(&str,2,999)
- lcla &deref
- &deref seta 0
- .a if &substr(&str,1,1)<>'*' goto .b
- &str setc &substr(&str,2,999)
- &deref seta &deref+1
- goto .a
- .b if &substr(&str,1,1)='<' then
- axisbyte set 1
- &str setc &substr(&str,2,999)
- endif
- lda &str
- if &deref>0 goto .c
- if axisbyte=1 goto .d
- .c ldx &str+1
- .d if &deref>0 then
- jsr deref
- &deref seta &deref-1
- goto .d
- endif
- mexit
- .imm
- &str setc &substr(&str,2,999)
- if &substr(&str,1,1)='<' then
- axisbyte set 1
- &str setc &substr(&str,2,999)
- endif
- lda #<&str
- if axisbyte=0 then
- ldx #>&str
- endif
- MEND
-
- ***************************************
-
- MACRO
- aycorm &op
- ayisbyte set 0
- lclc &str
- &str setc &op
- if &substr(&str,1,1)='#' goto .imm
- if &substr(&str,1,1)<>'*' then
- aerror 'non-variable parameter must start with a # or *'
- mexit
- endif
- &str setc &substr(&str,2,999)
- lcla &deref
- &deref seta 0
- .a if &substr(&str,1,1)<>'*' goto .b
- &str setc &substr(&str,2,999)
- &deref seta &deref+1
- goto .a
- .b if &substr(&str,1,1)='<' then
- ayisbyte set 1
- &str setc &substr(&str,2,999)
- endif
- lda &str
- if &deref>0 goto .c
- if ayisbyte=1 goto .d
- .c ldy &str+1
- .d if &deref>0 then
- jsr deref
- &deref seta &deref-1
- goto .d
- endif
- mexit
- .imm
- &str setc &substr(&str,2,999)
- if &substr(&str,1,1)='<' then
- ayisbyte set 1
- &str setc &substr(&str,2,999)
- endif
- lda #<&str
- if ayisbyte=0 then
- ldy #>&str
- endif
- MEND
-
-
- ***************************************
-
- MACRO
- fparm &op
- finline set 0
- lclc &str
- &str setc &op
- if &substr(&str,1,1)='#' goto .imm
- if &substr(&str,1,1)<>'*' then
- aerror 'non-variable parameter must start with a # or *'
- mexit
- endif
- lcla &deref
- &deref seta -1
- .a if &substr(&str,1,1)<>'*' goto .b
- &str setc &substr(&str,2,999)
- &deref seta &deref+1
- goto .a
- .b if &deref=0 then
- lda #<&str
- ldy #>&str
- mexit
- endif
- lda &str
- ldy &str+1
- .c
- &deref seta &deref-1
- if &deref=0 goto .e
- jsr deref
- goto .c
- .e mexit
- .imm
- finline set 1
- MEND
-
-
- *****************************************************************
- *****************************************************************
- *****************************************************************
-
-
- MACRO
- &lab _skipbyte
- &lab dc.b $24
- MEND
-
-
- *****************************************************************
-
-
- MACRO
- &lab _skipword
- &lab dc.b $2C
- MEND
-
-
- *****************************************************************
-
-
- MACRO
- &lab _int &op
- &lab aycorm &op
- if ayisbyte=1 then
- ldy #0
- endif
- MEND
-
-
- *****************************************************************
-
-
- MACRO
- &lab _ptr &op
- &lab aycorm &op
- if ayisbyte=1 then
- ldy #0
- endif
- MEND
-
-
- *****************************************************************
-
-
- MACRO
- &lab _byte &op
- &lab acorm &op
- MEND
-
-
- *****************************************************************
- *****************************************************************
- *****************************************************************
-
-
- * This macro initializes everything necessary in the runtime and runtime
- * macros. It initializes global macro variables and resets everything
- * in the runtime so the application can resume if the user presses a reset.
- MACRO
- &lab _rtreset
- &lab jsr rtreset
- MEND
-
-
- ***************************************
-
-
- * This macro is used to turn on the hi-bit for characters that are sent to rtcout.
- MACRO
- &lab _hibitchrs
- &lab jsr hibitchrs
- MEND
-
-
- ***************************************
-
-
- * This macro is used to turn off the hi-bit for characters that are sent to rtcout.
- MACRO
- &lab _lowbitchrs
- &lab jsr lowbitchrs
- MEND
-
-
- ***************************************
-
-
- * This macro is used to make sure that characters sent to rtcout are used as-is. There
- * will be no modification of the hi-bit.
- MACRO
- &lab _regchrs
- &lab jsr regchrs
- MEND
-
-
- ***************************************
-
-
- * This macro prints a character. This character is either already in the acc
- * (no operand), or what is described by the operand. The operand can either
- * be an absolute or a value in memory.
- * (acorm means load Acc with a Constant OR Memory value).
- MACRO
- &lab _rtcout &op
- &lab
- if &op='' goto .jsr
- acorm &op
- .jsr jsr rtcout
- MEND
-
-
- ***************************************
-
-
- * This macro prints ascii data following the _write macro. The write routine
- * works by using the return address as a pointer to the ascii data. The ascii
- * data is terminated with a 0 (C-string style). When the write routine
- * encounters a 0, it sets the return address so the when an rts is executed,
- * it returns to the code following the 0 terminator. As many parameters as
- * are desired can be passed to this routine. If the ascii data is more than
- * 1 line, end it with a comma,backslash to indicate line continuation.
- MACRO
- &lab _write
- &lab
- if &syslist[1]='' then
- aerror '_write: must have at least one parameter'
- mexit
- endif
- jsr write
- lcla &i,&n
- &i seta 1
- &n seta &nbr(&syslist)
- .a dc.b &syslist[&i]
- &i seta &i+1
- if &i<=&n goto .a
- dc.b 0
- MEND
-
-
- ***************************************
-
-
- * This macro prints a carriage return.
- MACRO
- &lab _writecr
- &lab jsr writecr
- MEND
-
-
- ***************************************
-
-
- * This macro outputs op number of spaces. If there is no op, then
- * the number of spaces to be output is assumed to be in the yreg.
- MACRO
- &lab _space &op
- &lab
- if &op='' goto .jsr
- ycorm &op
- .jsr jsr repeatsp
- MEND
-
-
- ***************************************
-
-
- * This macro outputs op2 number of the character op1. If there is no op1,
- * then the character is assumed to be in the acc. If there is no op2, then
- * the number of times the char should be output is assumed to be in the yreg.
- MACRO
- &lab _repeat &op1,&op2
- &lab
- if &op1='' goto .a
- acorm &op1
- .a if &op2='' goto .jsr
- ycorm &op2
- .jsr jsr repeat
- MEND
-
-
- ***************************************
-
-
- * This macro prints a c string pointed to by the operand.
- MACRO
- &lab _wrcstr &op
- &lab
- if &op='' goto .jsr
- _ptr &op
- .jsr jsr wrcstr
- MEND
-
-
- ***************************************
- ***************************************
- ***************************************
-
-
- * This macro sets signed mode. Printing decimal numbers is affected by this.
- MACRO
- &lab _signed
- &lab jsr signed
- MEND
-
-
- ***************************************
-
-
- * This macro sets unsigned mode. Printing decimal numbers is affected by this.
- MACRO
- &lab _unsigned
- &lab jsr unsigned
- MEND
-
-
- ***************************************
-
-
- * This macro does a two's compliment on the variable.
- MACRO
- &lab _chngsgn
- &lab jsr chngsgn
- MEND
-
-
- ***************************************
-
-
- * This macro prints a 1-byte decimal value. This value is either already in
- * the acc (no operand), or what is described by the operand. The operand can
- * either be an absolute or a value in memory.
- MACRO
- &lab _decoutl &op
- &lab
- if &op='' goto .jsr
- acorm &op
- .jsr jsr decoutl
- MEND
-
-
- ***************************************
-
-
- * This macro prints a 2-byte decimal value. This value is stored in a
- * variable. The variable number is either already in the xreg (no operand),
- * or is determined by the operand.
- MACRO
- &lab _vdecout &op
- &lab
- if &op='' goto .jsr
- ldx #<&op
- .jsr jsr vdecout
- MEND
-
-
- ***************************************
-
-
- * This macro prints a 1- or 2-byte decimal value. This value is either already
- * in the acc,y (no operand), or what is described by the operand. The operand
- * can either be an absolute or a value in memory.
- MACRO
- &lab _decout &op
- &lab
- if &op='' goto .jsr
- aycorm &op
- if ayisbyte=1 then
- jsr decoutl
- mexit
- endif
- .jsr jsr decout
- MEND
-
-
- ***************************************
-
-
- * This macro sets pad mode for hex. The value is either already in the acc
- * (no operand), or what is described by the operand. The operand can either
- * be an absolute or a value in memory. Printing hex numbers is affected by
- * this.
- MACRO
- &lab _hexpad &op
- &lab
- if &op='' goto .jsr
- acorm &op
- .jsr jsr hexpad
- MEND
-
-
- ***************************************
-
-
- * This macro sets no pad mode for hex. Printing hex numbers is affected by
- * this.
- MACRO
- &lab _hexnopad
- &lab jsr hexnopad
- MEND
-
-
- ***************************************
-
-
- * This macro prints a 1-byte hex value. This value is either already in the
- * acc (no operand), or what is described by the operand. The operand can
- * either be an absolute or a value in memory.
- MACRO
- &lab _hexoutl &op
- &lab
- if &op='' goto .jsr
- acorm &op
- .jsr jsr hexoutl
- MEND
-
-
- ***************************************
-
-
- * This macro prints a 2-byte hex value. This value is stored in a variable.
- * The variable number is either already in the xreg (no operand), or is
- * determined by the operand.
- MACRO
- &lab _vhexout &op
- &lab
- if &op='' goto .jsr
- ldx #<&op
- .jsr jsr vhexout
- MEND
-
-
- ***************************************
-
-
- * This macro prints a 1- or 2-byte hex value. This value is either already in
- * the acc,y (no operand), or what is described by the operand. The operand can
- * either be an absolute or a value in memory.
- MACRO
- &lab _hexout &op
- &lab
- if &op='' goto .jsr
- _int &op
- .jsr jsr hexout
- MEND
-
-
- ***************************************
-
-
- * This macro adds a variable to the destination variable. If there is no
- * op1, then the destination variable number is assumed to be in the xreg.
- * If there is no op2, then the source variable number is assumed to be in
- * the yreg.
- MACRO
- &lab _addvar &op1,&op2
- &lab
- if &op1='' goto .a
- ldx #<&op1
- .a if &op2='' goto .jsr
- ldy #<&op2
- .jsr jsr addvar
- MEND
-
-
- ***************************************
-
-
- * This macro adds a 1-byte value to the destination variable. If there is
- * no op1, then the destination variable number is assumed to be in the xreg.
- * If there is no op2, then the value is assumed to be in the acc.
- MACRO
- &lab _addl &op1,&op2
- &lab
- if &op1='' goto .a
- ldx #<&op1
- .a if &op2='' goto .jsr
- acorm &op2
- .jsr jsr addconl
- MEND
-
-
- ***************************************
-
-
- * This macro adds a 2-byte value to the destination variable. If there is
- * no op1, then the destination variable number is assumed to be in the xreg.
- * If there is no op2, then the value is assumed to be in acc,y.
- MACRO
- &lab _add &op1,&op2
- &lab
- if &op1='' goto .a
- ldx #<&op1
- .a if &op2='' goto .jsr
- aycorm &op2
- if ayisbyte=1 then
- jsr addconl
- mexit
- endif
- .jsr jsr addcon
- MEND
-
-
- ***************************************
-
-
- * This macro subtracts a variable from the destination variable. If there is
- * no op1, then the destination variable number is assumed to be in the xreg.
- * If there is no op2, then the source variable number is assumed to be in
- * the yreg.
- MACRO
- &lab _subvar &op1,&op2
- &lab
- if &op1='' goto .a
- ldx #<&op1
- .a if &op2='' goto .jsr
- ldy #<&op2
- .jsr jsr subvar
- MEND
-
-
- ***************************************
-
-
- * This macro subtracts a 1-byte value from the destination variable. If there
- * is no op1, then the destination variable number is assumed to be in the xreg.
- * If there is no op2, then the value is assumed to be in the acc.
- MACRO
- &lab _subl &op1,&op2
- &lab
- if &op1='' goto .a
- ldx #<&op1
- .a if &op2='' goto .jsr
- acorm &op2
- .jsr jsr subconl
- MEND
-
-
- ***************************************
-
-
- * This macro subtracts a 2-byte value from the destination variable. If there
- * is no op1, then the destination variable number is assumed to be in the xreg.
- * If there is no op2, then the value is assumed to be in acc,y.
- MACRO
- &lab _sub &op1,&op2
- &lab
- if &op1='' goto .a
- ldx #<&op1
- .a if &op2='' goto .jsr
- aycorm &op2
- if ayisbyte=1 then
- jsr subconl
- mexit
- endif
- .jsr jsr subcon
- MEND
-
-
- ***************************************
-
-
- * This macro multiplies the destination variable by a variable. If there is
- * no op1, then the destination variable number is assumed to be in the xreg.
- * If there is no op2, then the source variable number is assumed to be in
- * the yreg.
- MACRO
- &lab _mulvar &op1,&op2
- &lab
- if &op1='' goto .a
- ldx #<&op1
- .a if &op2='' goto .jsr
- ldy #<&op2
- .jsr jsr mulvar
- MEND
-
-
- ***************************************
-
-
- * This macro multiplies the destination variable by a 1-byte value. If there
- * is no op1, then the destination variable number is assumed to be in the xreg.
- * If there is no op2, then the value is assumed to be in the acc.
- MACRO
- &lab _mull &op1,&op2
- &lab
- if &op1='' goto .a
- ldx #<&op1
- .a if &op2='' goto .jsr
- acorm &op2
- .jsr jsr mulconl
- MEND
-
-
- ***************************************
-
-
- * This macro multiplies the destination variable by a 2-byte value. If there
- * is no op1, then the destination variable number is assumed to be in the xreg.
- * If there is no op2, then the value is assumed to be in acc,y.
- MACRO
- &lab _mul &op1,&op2
- &lab
- if &op1='' goto .a
- ldx #<&op1
- .a if &op2='' goto .jsr
- aycorm &op2
- if ayisbyte=1 then
- jsr mulconl
- mexit
- endif
- .jsr jsr mulcon
- MEND
-
-
- ***************************************
-
-
- * This macro divides the destination variable by a variable. If there is
- * no op1, then the destination variable number is assumed to be in the xreg.
- * If there is no op2, then the source variable number is assumed to be in
- * the yreg. The remainder from the divide is in the acc,y.
- MACRO
- &lab _divvar &op1,&op2
- &lab
- if &op1='' goto .a
- ldx #<&op1
- .a if &op2='' goto .jsr
- ldy #<&op2
- .jsr jsr divvar
- MEND
-
-
- ***************************************
-
-
- * This macro divides the destination variable by a 1-byte value. If there
- * is no op1, then the destination variable number is assumed to be in the xreg.
- * If there is no op2, then the value is assumed to be in the acc. The
- * remainder from the divide is in the acc,y.
- MACRO
- &lab _divl &op1,&op2
- &lab
- if &op1='' goto .a
- ldx #<&op1
- .a if &op2='' goto .jsr
- acorm &op2
- .jsr jsr divconl
- MEND
-
-
- ***************************************
-
-
- * This macro divides the destination variable by a 2-byte value. If there
- * is no op1, then the destination variable number is assumed to be in the xreg.
- * If there is no op2, then the value is assumed to be in acc,y. The remainder
- * from the divide is in the acc,y.
- MACRO
- &lab _div &op1,&op2
- &lab
- if &op1='' goto .a
- ldx #<&op1
- .a if &op2='' goto .jsr
- aycorm &op2
- if ayisbyte=1 then
- jsr divconl
- mexit
- endif
- .jsr jsr divcon
- MEND
-
-
- ***************************************
-
-
- * This macro sets the current variable. The current variable is defined by
- * a number in the xreg. All runtime functions preserve the xreg, so multiple
- * operations can be done to the same variable without having to reload the xreg
- * with the variable number.
- MACRO
- &lab _var &op
- &lab ldx #<&op
- MEND
-
-
- ***************************************
-
- * This macro uses a variable as a pointer and sets that variable to the value to where
- * that pointer currently points. The macro preserves all registers.
- * The c equivalent would be (using longs instead if ints):
- *
- * long *ptrvar;
- *
- * ptrvar = (long *)*ptrvar;
- *
- MACRO
- &lab _vderef &op
- &lab
- if &op='' goto .jsr
- ldx #<&op
- .jsr jsr vderef
- MEND
-
-
- ***************************************
-
-
- * This macro sets a variable to 0. If there is no op1, then the destination
- * variable number is assumed to be in the xreg.
- MACRO
- &lab _set0 &op
- &lab
- if &op='' goto .jsr
- ldx #<&op
- .jsr jsr setzero
- MEND
-
-
- ***************************************
-
-
- * This macro sets a variable to another variable. If there is no op1, then the
- * destination variable number is assumed to be in the xreg. If there is no
- * op2, then the source variable number is assumed to be in the yreg.
- MACRO
- &lab _varcpy &op1,&op2
- &lab
- if &op1='' goto .a
- ldx #<&op1
- .a if &op2='' goto .jsr
- ldy #<&op2
- .jsr jsr seteq
- MEND
-
-
- ***************************************
-
-
- * This macro sets a variable to a 1-byte value. If there is no op1, then the
- * destination variable number is assumed to be in the xreg. If there is no
- * op2, then the value is assumed to be in the acc.
- MACRO
- &lab _setl &op1,&op2
- &lab
- if &op1='' goto .a
- ldx #<&op1
- .a if &op2='' goto .jsr
- acorm &op2
- .jsr jsr setconl
- MEND
-
-
- ***************************************
-
-
- * This macro sets a variable to a 2-byte value. If there is no op1, then the
- * destination variable number is assumed to be in the xreg. If there is no
- * op2, then the value is assumed to be in acc,y.
- MACRO
- &lab _set &op1,&op2
- &lab
- if &op1='' goto .a
- ldx #<&op1
- .a if &op2='' goto .jsr
- aycorm &op2
- if ayisbyte=1 then
- jsr setconl
- mexit
- endif
- .jsr jsr setcon
- MEND
-
-
- ***************************************
-
-
- * This macro is used to set a bunch of variables to constant values.
- * There must be a non-zero even number of parameters. The odd parameters
- * are the variables, and the even parameters are the constant values for
- * the preceeding parameter. The setvars routine uses the return address
- * as a pointer to the data (just like the write routine). It simply
- * sets the designated variable to the designated constant until it
- * encounters a 255 as a variable value. A 255 is reserved for this
- * purpose. This macro places a 255 at the end of the data list
- * automatically.
- MACRO
- &lab _setvars
- &lab
- if &syslist[2]='' then
- aerror '_setvars: must have at least two parameters'
- mexit
- endif
- jsr setvars
- lcla &i,&j,&n
- &i seta 1
- &j seta 2
- &n seta &nbr(&syslist)
- .a if &syslist[&j]='' then
- aerror '_setvars: must have even number of parameters'
- mexit
- endif
- dc.b &syslist[&i]
- if &substr(&syslist[&j],1,1)<>'#' then
- aerror '_setvars: variables can only be set to constants -- missing #'
- mexit
- endif
- dc.w &substr(&syslist[&j],2,999)
- &i seta &i+2
- &j seta &j+2
- if &i<=&n goto .a
- dc.b 255
- MEND
-
-
- ***************************************
-
-
- * This macro swaps the two variables if the xreg variable is bigger than the
- * yreg variable. If there is no op1, then the destination variable number is
- * assumed to be in the xreg. If there is no op2, then the source variable
- * number is assumed to be in the yreg.
- MACRO
- &lab _minswap &op1,&op2
- &lab
- if &op1='' goto .a
- ldx #<&op1
- .a if &op2='' goto .jsr
- ldy #<&op2
- .jsr jsr xlty
- MEND
-
-
- ***************************************
-
-
- * This macro swaps the two variables if the xreg variable is smaller than the
- * yreg variable. If there is no op1, then the destination variable number is
- * assumed to be in the xreg. If there is no op2, then the source variable
- * number is assumed to be in the yreg.
- MACRO
- &lab _maxswap &op1,&op2
- &lab
- if &op1='' goto .a
- ldx #<&op1
- .a if &op2='' goto .jsr
- ldy #<&op2
- .jsr jsr xgty
- MEND
-
-
- ***************************************
-
-
- * This macro does a signed compare of two variables. The equal status is true
- * if the variables are equal. If the xreg variable is greater or equal, then
- * the carry is set. If the xreg variable is smaller, then the carry is clear.
- * If there is no op1, then the variable number is assumed to be in the xreg.
- * If there is no op2, then the variable number is assumed to be in the yreg.
- MACRO
- &lab _vsgncmp &op1,&op2
- &lab
- if &op1='' goto .a
- ldx #<&op1
- .a if &op2='' goto .jsr
- ldy #<&op2
- .jsr jsr vifsgneq
- MEND
-
-
- ***************************************
-
-
- * This macro does an unsigned compare of two variables. The equal status is
- * true if the variables are equal. If the xreg variable is greater or equal,
- * then the carry is set. If the xreg variable is smaller, then the carry is
- * clear. If there is no op1, then the variable number is assumed to be in the
- * xreg. If there is no op2, then the variable number is assumed to be in the
- * yreg.
- MACRO
- &lab _vcmp &op1,&op2
- &lab
- if &op1='' goto .a
- ldx #<&op1
- .a if &op2='' goto .jsr
- ldy #<&op2
- .jsr jsr vifequal
- MEND
-
-
- ***************************************
-
-
- * This macro works the same as _vsgncmp, except that it compares a variable
- * against a constant or value from memory at a specified location.
- MACRO
- &lab _sgncmp &op1,&op2
- &lab
- if &op1='' goto .a
- ldx #<&op1
- .a if &op2='' goto .jsr
- _int &op2
- .jsr jsr ifsgneq
- MEND
-
-
- ***************************************
-
-
- * This macro works the same as _vcmp, except that it compares a variable
- * against a constant or value from memory at a specified location.
- MACRO
- &lab _cmp &op1,&op2
- &lab
- if &op1='' goto .a
- ldx #<&op1
- .a if &op2='' goto .jsr
- _int &op2
- .jsr jsr ifequal
- MEND
-
-
- ***************************************
- ***************************************
- ***************************************
-
-
- * This macro is used to seed the random number generator. If there is
- * no op1, then the random seed is assumed to be in the acc,y.
- MACRO
- &lab _rndseed &op
- &lab
- if &op='' goto .jsr
- _int &op
- .jsr jsr seedrandom
- MEND
-
-
- ***************************************
-
-
- * This macro is used to return a random number from 0 to op - 1. If there is
- * no op1, then the random number limit is assumed to be in the acc,y.
- MACRO
- &lab _random &op
- &lab
- if &op='' goto .jsr
- _int &op
- .jsr jsr calcrandom
- MEND
-
-
- ***************************************
- ***************************************
- ***************************************
-
-
- * This macro takes the value of a string and returns it in the acc,y.
- * If there is no op1, then the string number is assumed to be in the xreg.
- MACRO
- &lab _strval &op
- &lab
- if &op='' goto .jsr
- ldx #<&op
- .jsr jsr strval
- MEND
-
-
- ***************************************
-
-
- * This macro takes the value of op1 string starting at op2 character and
- * returns it in the acc,y. If there is no op1, then the string number is
- * assumed to be in the xreg. If there is no op2, then the character number
- * is assumed to be in the yreg.
- MACRO
- &lab _midstrval &op1,&op2
- &lab
- if &op1='' goto .a
- ldx #<&op1
- .a if &op2='' goto .jsr
- ycorm &op2
- .jsr jsr midstrval
- MEND
-
-
- ***************************************
-
-
- * This macro prints the entire string. If there is no op1, then the string
- * number is assumed to be in the xreg.
- MACRO
- &lab _prstr &op
- &lab
- if &op='' goto .jsr
- ldx #<&op
- .jsr jsr prstr
- MEND
-
-
- ***************************************
-
-
- * This macro redirects output to the string. If there is no op1, then
- * the string number is assumed to be in the xreg.
- MACRO
- &lab _out2str &op
- &lab
- if &op='' goto .jsr
- ldx #<&op
- .jsr jsr out2str
- MEND
-
-
- ***************************************
-
-
- * This macro points a string to a designated memory location. If there
- * is no op1, then the string number is assumed to be in the xreg.
- MACRO
- &lab _strptr &op1,&op2
- &lab
- if &op1='' goto .a
- ldx #<&op1
- .a if &op2='' goto .jsr
- _ptr &op2
- .jsr jsr strptr
- MEND
-
-
- ***************************************
-
-
- * This macro clears the string. If there is no op1, then
- * the string number is assumed to be in the xreg.
- MACRO
- &lab _nullstr &op
- &lab
- if &op='' goto .jsr
- ldx #<&op
- .jsr jsr nullstr
- MEND
-
-
- ***************************************
-
-
- * This macro resets output to the setting prior to calling out2str.
- * out2str can be called multiple times, and only one call to out2stroff
- * is needed. (out2str saved the output hook if it is DIFFERENT than
- * what out2str sets it to.)
- MACRO
- &lab _out2stroff
- &lab jsr out2stroff
- MEND
-
-
- ***************************************
-
-
- * This macro prints op1 string starting at the first character for op2
- * characters. If there is no op1, then the string number is assumed to be
- * in the xreg. If there is no op2, then the number of characters is assumed
- * to be in the acc.
- MACRO
- &lab _prleftstr &op1,&op2
- &lab
- if &op1='' goto .a
- ldx #<&op1
- .a if &op2='' goto .jsr
- acorm &op2
- .jsr jsr prleftstr
- MEND
-
-
- ***************************************
-
-
- * This macro prints op1 string starting at the op2 character for op3
- * characters. If there is no op1, then the string number is assumed to be
- * in the xreg. If there is no op2, then the character number is assumed to
- * be in the yreg. If there is no op3, then the number of characters is
- * assumed to be in the acc.
- MACRO
- &lab _prmidstr &op1,&op2,&op3
- &lab
- if &op1='' goto .a
- ldx #<&op1
- .a if &op2='' goto .b
- ycorm &op2
- .b if &op3='' goto .jsr
- acorm &op3
- .jsr jsr prmidstr
- MEND
-
-
- ***************************************
-
-
- * This macro copies op3 characters from op2 string to op1 string. If there
- * is no op1, then the destination string number is assumed to be in the xreg.
- * If there is no op2, then the source string number is assumed to be in the
- * yreg. If there is no op3, then the number of characters is assumed to be
- * in the acc.
- MACRO
- &lab _leftstrcpy &op1,&op2,&op3
- &lab
- if &op1='' goto .a
- ldx #<&op1
- .a if &op2='' goto .b
- ldy #<&op2
- .b if &op3='' goto .jsr
- acorm &op3
- .jsr jsr leftstrcpy
- MEND
-
-
- ***************************************
-
-
- * This macro copies op2 string to op1 string. If there is no op1, then the
- * destination string number is assumed to be in the xreg. If there is no op2,
- * then the source string number is assumed to be in the yreg.
- MACRO
- &lab _strcpy &op1,&op2
- &lab
- if &op1='' goto .a
- ldx #<&op1
- .a if &op2='' goto .jsr
- ldy #<&op2
- .jsr jsr strcpy
- MEND
-
-
- ***************************************
-
-
- * This macro copies op4 characters, starting at op3 character from op2 string
- * to op1 string. If there is no op1, then the destination string number is
- * assumed to be in the xreg. If there is no op2, then the source string number
- * is assumed to be in the yreg. If there is no op3, then the character number
- * is assumed to be in the acc. If there is no op4, then all characters to the
- * end of the source string will be copied to the destination string. The op4
- * case is the only case where the assumed value is a particular value (#255),
- * instead of what is in a register. This is the case because there are only
- * three registers.
- MACRO
- &lab _midstrcpy &op1,&op2,&op3,&op4
- &lab
- if &op4='' goto .b
- if &op3<>'' goto .a
- pha
- .a
- acorm &op4
- sta numtocopy
- if &op3<>'' goto .b
- pla
- .b if &op1='' goto .c
- ldx #<&op1
- .c if &op2='' goto .d
- ldy #<&op2
- .d if &op3='' goto .jsr
- acorm &op3
- .jsr jsr midstrcpy
- MEND
-
-
- ***************************************
-
-
- * This macro concatenates op3 characters of op2 string onto op1 string. If
- * there is no op1, then the destination string number is assumed to be in the
- * xreg. If there is no op2, then the source string number is assumed to be in
- * the yreg. If there is no op3, then the number of characters is assumed to
- * be in the acc.
- MACRO
- &lab _leftstrcat &op1,&op2,&op3
- &lab
- if &op1='' goto .a
- ldx #<&op1
- .a if &op2='' goto .b
- ldy #<&op2
- .b if &op3='' goto .jsr
- acorm &op3
- .jsr jsr leftstrcat
- MEND
-
-
- ***************************************
-
-
- * This macro concatenates op2 string onto op1 string. If there is no op1,
- * then the destination string number is assumed to be in the xreg. If there
- * is no op2, then the source string number is assumed to be in the yreg.
- MACRO
- &lab _strcat &op1,&op2
- &lab
- if &op1='' goto .a
- ldx #<&op1
- .a if &op2='' goto .jsr
- ldy #<&op2
- .jsr jsr strcat
- MEND
-
-
- ***************************************
-
-
- * This macro concatenates op4 characters starting at op3 character from op2
- * string onto op1 string. If there is no op1, then the destination string
- * number is assumed to be in the xreg. If there is no op2, then the source
- * string number is assumed to be in the yreg. If there is no op3, then the
- * character number is assumed to be in the acc. If there is no op4, then all
- * characters to the end of the source string will be concatenated to the
- * destination string. The op4 case is the only case where the assumed value
- * is a particular value (#255), instead of what is in a register. This is
- * the case because there are only three registers.
- MACRO
- &lab _midstrcat &op1,&op2,&op3,&op4
- &lab
- if &op4='' goto .b
- if &op3<>'' goto .a
- pha
- .a
- acorm &op4
- sta numtocopy
- if &op3<>'' goto .b
- pla
- .b if &op1='' goto .c
- ldx #<&op1
- .c if &op2='' goto .d
- ldy #<&op2
- .d if &op3='' goto .jsr
- acorm &op3
- .jsr jsr midstrcat
- MEND
-
-
- ***************************************
-
-
- * This macro is used to take some literal string data and place it into
- * a string. It works very much like the write routine, except that it
- * copies the characters into a string instead of printing them. Operand
- * 1 is the string variable, if there is one designated. If there is not
- * one designated, then the x-reg is assumed to already hold it. There
- * then must be a second parameter. This parameter would be string data.
- * There may be other parameters, which would also hold string data.
- * When all data parameters are used by this macro, the macro then places
- * a 0 terminator to indicate the end of the literal data.
- MACRO
- &lab _litstr
- &lab
- if &syslist[2]='' then
- aerror '_litstr: must have a second parameter'
- mexit
- endif
- if &syslist[1]='' goto .jsr
- ldx #<&syslist[1]
- .jsr jsr litstr
- lcla &i,&n
- &i seta 2
- &n seta &nbr(&syslist)
- .a dc.b &syslist[&i]
- &i seta &i+1
- if &i<=&n goto .a
- dc.b 0
- MEND
-
-
- ***************************************
-
-
- * This macro returns the op2th character of op1 string. If there is no op1,
- * then the destination string number is assumed to be in the xreg. If there
- * is no op2, then the character number is assumed to be in the acc.
- MACRO
- &lab _strchr &op1,&op2
- &lab
- if &op1='' goto .a
- ldx #<&op1
- .a if &op2='' goto .jsr
- acorm &op2
- .jsr jsr strchr
- MEND
-
-
- ***************************************
-
-
- * This macro returns the physical location of op1 string in memory. The
- * string location is returned in acc,y.If there is no op1, then the
- * destination string number is assumed to be in the xreg.
- MACRO
- &lab _strloc &op1
- &lab
- if &op1='' goto .jsr
- ldx #<&op1
- .jsr jsr strloc
- MEND
-
-
- ***************************************
-
-
- MACRO
- &lab _cstr
- &lab
- if &syslist[1]='' then
- aerror '_write: must have at least one parameter'
- mexit
- endif
- lcla &i,&n
- &i seta 1
- &n seta &nbr(&syslist)
- .a dc.b &syslist[&i]
- &i seta &i+1
- if &i<=&n goto .a
- dc.b 0
- MEND
-
-
- ***************************************
- ***************************************
- ***************************************
-
-
- * This macro sets the read data pointer. If there is no op, then the address
- * for reading data is assumed to be in the acc,y.
- MACRO
- &lab _restore &op
- &lab
- if &op='' goto .jsr
- _ptr &op
- .jsr jsr restore
- MEND
-
-
- ***************************************
-
-
- * This macro reads an int from the current data pointer and advances the
- * pointer by two bytes. If there is no op1, then the destination variable
- * number is assumed to be in the xreg.
- MACRO
- &lab _readint &op
- &lab
- if &op='' goto .jsr
- ldx #<&op
- .jsr jsr readint
- MEND
-
-
- ***************************************
-
-
- * This macro reads string data into the designated string until the
- * end-of-string character is encountered. The data pointer is then set to
- * point after this end-of-string character. If there is no op1, then the
- * destination string number is assumed to be in the xreg.
- MACRO
- &lab _readstr &op
- &lab
- if &op='' goto .jsr
- ldx #<&op
- .jsr jsr readstr
- MEND
-
-
- ***************************************
-
-
- * This macro is used to set the end-of-string character for _readstr. If
- * there is no op1, then the _readstr ending character is assumed to be in
- * the acc.
- MACRO
- &lab _readend &op
- &lab
- if &op='' goto .jsr
- acorm &op
- .jsr jsr readend
- MEND
-
-
- ***************************************
- ***************************************
- ***************************************
-
-
- * This macro is used to define some memory as an array of up to
- * 4 dimensions. The first parameter is the location of the
- * array, or where the location of the array is stored. The second
- * parameter is the size of the elements, (b)yte or (w)ord. The
- * third parameter is the first dimension. The macro and routines
- * actually ignore this dimension, since it would only be used for
- * range checking anyway. The fourth through sixth parameters are
- * optional. The more parameters, the more dimensions in the array.
- MACRO
- &lab _array &loc,&elesize,&op1,&op2,&op3,&op4
- lclc &str
- &str setc &elesize
- &lab
- if &loc='' goto .a
- aycorm &loc
- if ayisbyte=1 then
- ldy #0
- endif
- .a jsr arraybase
- if &op4='' goto .b
- if &substr(&op4,1,1)<>'#' then
- .err aerror '_array: dimensions must be constants -- parameter must be preceeded by a #'
- mexit
- endif
- .b if &op3='' goto .c
- if &substr(&op3,1,1)<>'#' goto .err
- .c if &op2='' goto .d
- if &substr(&op2,1,1)<>'#' goto .err
- .d if &op1='' goto .e
- if &substr(&op1,1,1)<>'#' goto .err
- .e if &substr(&str,1,1)='#' goto .f
- aerror '_array: element size must be constant'
- mexit
- .f
- &str setc &substr(&str,2,999)
- if &op4>'' goto .e4
- if &op3>'' goto .e3
- if &op2>'' goto .e2
- mexit
- .e2 dc.w &str
- dc.w &substr(&op2,2,999)*&str
- dc.w 0
- mexit
- .e3 dc.w &str
- dc.w &substr(&op2,2,999)*&substr(&op3,2,999)*&str
- dc.w &substr(&op3,2,999)*&str
- dc.w 0
- mexit
- .e4 dc.w &str
- dc.w &substr(&op2,2,999)*&substr(&op3,2,999)*&substr(&op4,2,999)*&str
- dc.w &substr(&op3,2,999)*&substr(&op4,2,999)*&str
- dc.w &substr(&op4,2,999)*&str
- dc.w 0
- mexit
- MEND
-
-
- ***************************************
-
-
- * This macro is used to index into the current array (defined by _array).
- * The whole goal of the array handling is to index down to the row level.
- * Once at the row level, you use the right-most subscript to index into
- * that row. This makes working on a row very fast, since all subscripts
- * are not involved each time. So, _index would be used for all subscripts
- * except for the last subscript. The parameter can either be a constant,
- * (preceeded with a #) or can be a location in ram that holds the index
- * (preceeded with an *).
- MACRO
- &lab _index &op1,&op2,&op3
- &lab
- if &op1='' goto .a
- aycorm &op1
- if ayisbyte=1 then
- jsr arraylindx1
- else
- jsr arrayindx1
- endif
- .a if &op2='' goto .b
- aycorm &op2
- if ayisbyte=1 then
- jsr arraylindx2
- else
- jsr arrayindx2
- endif
- .b if &op3='' goto .c
- aycorm &op3
- if ayisbyte=1 then
- jsr arraylindx3
- else
- jsr arrayindx3
- endif
- .c MEND
-
-
- ***************************************
-
-
- * This macro works the same as _index, except that the index is stored
- * in the variable indicated.
- MACRO
- &lab _vindex &op1,&op2,&op3
- &lab
- if &op1='' goto .a
- ldy #<&op1
- jsr varyindx1
- .a if &op2='' goto .b
- ldy #<&op2
- jsr varyindx2
- .b if &op3='' goto .c
- ldy #<&op3
- jsr varyindx3
- .c MEND
-
-
- ***************************************
-
-
- * This macro gets an element from the working row of the current array.
- * The final index parameter is used to index into this row.
- MACRO
- &lab _get &op1,&op2
- &lab
- if &op1='' goto .a
- ldx #<&op1
- .a if &op2='' goto .jsr
- aycorm &op2
- if ayisbyte=1 then
- jsr getelel
- mexit
- endif
- .jsr jsr getele
- MEND
-
-
- ***************************************
-
-
- * This macro gets an element from the working row of the current array.
- * The final index parameter is used to index into this row.
- MACRO
- &lab _getl &op1,&op2
- &lab
- if &op1='' goto .a
- ldx #<&op1
- .a if &op2='' goto .jsr
- acorm &op2
- .jsr jsr getelel
- MEND
-
-
- ***************************************
-
-
- * This macro puts an element from the working row of the current array.
- * The final index parameter is used to index into this row.
- MACRO
- &lab _put &op1,&op2
- &lab
- if &op1='' goto .a
- ldx #<&op1
- .a if &op2='' goto .jsr
- aycorm &op2
- if ayisbyte=1 then
- jsr putelel
- mexit
- endif
- .jsr jsr putele
- MEND
-
-
- ***************************************
-
-
- * This macro puts an element from the working row of the current array.
- * The final index parameter is used to index into this row.
- MACRO
- &lab _putl &op1,&op2
- &lab
- if &op1='' goto .a
- ldx #<&op1
- .a if &op2='' goto .jsr
- acorm &op2
- .jsr jsr putelel
- MEND
-
-
- ***************************************
-
-
- * This macro gets an element from the working row of the current array.
- * The final index parameter is used to index into this row.
- MACRO
- &lab _vget &op1,&op2
- &lab
- if &op1='' goto .a
- ldx #<&op1
- .a if &op2='' goto .jsr
- ldy #<&op2
- .jsr jsr vgetele
- MEND
-
-
- ***************************************
-
-
- * This macro puts an element from the working row of the current array.
- * The final index parameter is used to index into this row.
- MACRO
- &lab _vput &op1,&op2
- &lab
- if &op1='' goto .a
- ldx #<&op1
- .a if &op2='' goto .jsr
- ldy #<&op2
- .jsr jsr vputele
- MEND
-
-
- ***************************************
-
-
- * This macro gets the next element from the current array.
- MACRO
- &lab _getnext &op
- &lab
- if &op='' goto .jsr
- ldx #<&op
- .jsr jsr getnextele
- MEND
-
-
- ***************************************
-
-
- * This macro puts the next element from the current array.
- MACRO
- &lab _putnext &op
- &lab
- if &op='' goto .jsr
- ldx #<&op
- .jsr jsr putnextele
- MEND
-
-
- ***************************************
-